home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload Trio 2
/
Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO
/
dir44
/
advsrc.zip
/
ADARR.FOR
< prev
next >
Wrap
Text File
|
1993-07-29
|
7KB
|
173 lines
C Adventure Data Base Array Lister Program For Debugging Stuff--2byte
c Written for MS DOS PDS FORTRAN v5.10
c by Paul Muñoz-Colman, FunStuff Software
c 27 Mar 1993
c 12 August 1985
C
$NODEBUG
$notstrict
$storage: 2
IMPLICIT INTEGER*2 (A-Z)
character*4 wd1,wd2,iz,bl,atab(295),wd1x,wd2x
integer*4 travel(745),itk(20),newloc,linuse,kk,linsiz,ldex
integer*4 iwd2,ll,izz,index,linpt
c
equivalence(iwd2,wd2),(izz,iz)
CHARACTER*2 LINES (21150)
CHARACTER*12 FNAME
CHARACTER*2 clines
character*3 lines3(2),out1(25),out2(26)
DIMENSION KTAB(295),RTEXT(205)
DIMENSION LTEXT(150),STEXT(150),KEY(150),COND(150),ABB(150),
1 ATLOC(150)
DIMENSION PLAC(100),PLACE(100),FIXD(100),FIXED(100),LINK(200),
1 PTEXT(100),PROP(100)
DIMENSION ACTSPK(35)
DIMENSION CTEXT(12),CVAL(12)
DIMENSION HINTLC(20),HINTED(20),HINTS(20,4)
DIMENSION MTEXT(35)
DIMENSION DSEEN(6),DLOC(6),ODLOC(6),HNAME(4)
INTEGER*2 IDONDX
C
EQUIVALENCE(BL,IBL),(CLINES,ILINES)
c
c
open (1, file='ad.dat', form='unformatted')
c
c read the data base in array format
c
read (1) abbnum,axe,back,batter,bear,bird,bonus,bottle,
. cage,cave,chain,chasm,chest,chloc,chloc2,clam,
. clock1,clock2,closed,closng,coins,daltlc,detail,dflag,
. dkill,dloc,door,dprssn,dragon,dseen,dwarf,eggs,
. emrald,entrnc,find,fissur,foobar,food,gaveup,grate
c
read (1) invent,iwest,keys,knfloc,knife,lamp,lmwarn,
. lock,look,magzin,maxdie,maxtrs,messag,mirror,nugget,
. null,numdie,oil,oyster,panic,pearl,pillow,plant,
. plant2,pyram,rod,rod2,rug,saved,say,scorng,
. snake,spices,steps,tablet,tally,tally2,throw,tridnt,
. troll,troll2,turns,vase,vend,water,tabsiz,blklin,oldloc,fixed
c
read (1) linuse,trvs,tabndx,obj,verb,clsses,hntmax,loc,newloc,
. k,j,stext,ltext,ptext,rtext,ctext,cval,key,
. travel,ktab,plac,fixd,actspk,cond,hints,place,prop,link,
. abb,atloc,holdng,hinted,hintlc,kk,i,itk,atab,lines
c
close (1)
write (*,30)
30 format ('1travel',//)
c
do 28 itv=1,149
28 write (*,29) (travel(jt),jt=((itv-1)*5+1),((itv-1)*5+5)),itv*5
29 format (5i14,i6)
c
c now do lines array
open (3,file='temp',status='unknown')
write (*,31)
31 format ('1lines',//)
c
linpt=1
index=0
2 index=index+25
c don't let array index overflow please
if (ilines.eq.-1) go to 4
c find place in output line for array pointer label
c clear the two output lines
do 20 pp=1,26
if (pp .le. 25) out1(pp)=' '
20 out2(pp)=' '
c fill up the output line with the 25 lines words
do 25 ll=1,25
ldex=index-25+ll
25 out1(ll)=lines(ldex)
c check if index value needs to be put in output line
23 if (ilines.eq.-1.or.linpt.gt.index) go to 21
c found current index pointer that belongs in this output line
c write out as integer and reread as 2a3
clines=lines(linpt)
write (3,5) ilines
5 format (i6)
rewind 3
read (3,6) lines3
6 format (2a3)
rewind 3
c compute place in verbage and numerics output lines
sing=(mod(iabs(linpt),25))
if (sing.eq.0) sing=25
c fill numerics output line with 2a3
do 22 til=1,2
if (til.eq.1.and.ilines.lt.0) out1 (sing)='## '
if (til.eq.1.and.ilines.gt.0) out1 (sing)='// '
22 out2(sing+til-1)=lines3(til)
c get next pointer
if (ilines .ne. -1) linpt=iabs(ilines)
go to 23
c write output lines now
21 write (*,26) (out1(mm),mm=1,25),index
26 format (3x,25a3,i6)
write (*,41) (out2(mm),mm=1,26)
41 format (1x,26a3)
c do it again for the next line
go to 2
c
c
4 write(*,10) abbnum,axe,back,batter,bear,bird,bonus,bottle,
. cage,cave,chain,chasm,chest,chloc,chloc2,clam,
. clock1,clock2,closed,closng,coins,daltlc,detail,dflag,
. dkill,dloc,door,dprssn,dragon,dseen,dwarf,eggs,
. emrald,entrnc,find,fissur,foobar,food,gaveup,grate
c
10 format ('1abbnum,axe,back,batter,bear,bird,bonus,bottle,',
. 'cage,cave'//,10i8,//,' chain,chasm,chest,chloc,chloc2,clam,',
.'clock1,clock2,closed,closng'//10i8//,' coins,daltlc,detail,dfla'
.,'g,dkill',//,5i8,//,' dloc',//,6i8,//,
. ' door,dprssn,dragon',//,3i8,//,' dseen'//6i8//,' dwarf,eggs,',
.'emrald,entrnc,find,fissur,foobar,food,gaveup,grate',//,10i8,//)
c
write(*,11)invent,iwest,keys,knfloc,knife,lamp,lmwarn,
. lock,look,magzin,maxdie,maxtrs,messag,mirror,nugget,
. null,numdie,oil,oyster,panic,pearl,pillow,plant,
. plant2,pyram,rod,rod2,rug,saved,say,scorng,
. snake,spices,steps,tablet,tally,tally2,throw,tridnt,
. troll,troll2,turns,vase,vend,water,tabsiz,blklin,oldloc,fixed
c
11 format (' invent,iwest,keys,knfloc,knife,lamp,lmwarn,',
.'lock,look,magzin'//10i8//' maxdie,maxtrs,messag,mirror,nugget,',
.'null,numdie,oil,oyster,panic',//,10i8,//,' pearl,pillow,plant,',
. 'plant2,pyram,rod,rod2,rug,saved,say',//,10i8,//,' scorng',
.',snake,spices,steps,tablet,tally,tally2,throw,tridnt,',
. 'troll',//,10i8,//,
.' troll2,turns,vase,vend,water,tabsiz,blklin,oldloc,',//,
. 8i8,//,' fixed',//,10(10i8/),//)
c
write(*, 1)linuse,trvs,tabndx,obj,verb,clsses,hntmax,loc,newloc,
. k,j
1 format (' linuse,trvs,tabndx,obj,verb,clsses,hntmax,loc,newloc,'
. ,/,' k,j,',//,9i8,/,2i8,//)
write (*, 9) stext,ltext,ptext,rtext,ctext,cval,key,
. atab,ktab,plac,fixd,actspk,cond,hints
9 format (
. ' stext',//,15(10i8/),//,' ltext',//,15(10i8/),//,' ptext',//,
. 10(10i8/),//,' rtext',//,20(10i8/),5i8,//,' ctext',//,10i8,/,
.2i8,//,' cval'//10i8,/,2i8,//,' key'//15(10i8/),//,
. ' atab'//29(1x,10(a4,2x)/),1x,5(a4,2x),//,
. ' ktab'//29(10i8/),5i8,//,' plac',//,10(10i8/),//,' fixd',//,
. 10(10i8/),//,' actspk',//,3(10i8/),5i8,//,
. ' cond',//,15(10i8/),//,' hints',//,8(10i8/),//)
c
write (*,12) place,prop,link,
. abb,atloc,holdng,hinted,hintlc,kk,i,itk
c
12 format (' place',//,10(10i8/),//,' prop',//,10(10i8/),//,
. ' link',//,20(10i8/),//,' abb',//,15(10i8/),//,' atloc',//,
. 15(10i8/),//,' holdng',i8,//,' hinted',//,2(10i8/),//,
. ' hintlc',//,2(10i8/),//,' kk',i8,//,' i',//,i8,//,' itk',//,
. 2(10i8/),//)
c
write (*,27)
27 format (1h1,'================= END ================'///)
end